home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / Module source / listMan < prev    next >
Encoding:
Text File  |  1993-06-26  |  6.7 KB  |  226 lines  |  [TEXT/ttxt]
  1. \ list manager routines - window used for maintaining a scrollable list
  2. \ 6/29/92    rfl    fixed bug by allowing IMOD to be seen in scroll pane
  3. \ 5/23/93    rfl removed new: modlist...don't want this to happen during module compile
  4. \               also don't include imod itself.
  5. \ 6.26.93    rfl     fixed bug when clicking at edge of scrollbar..14 to 15 in setrect:
  6.  
  7. \ NEED TO PROTECT FOR 32K LIMIT
  8.  
  9. : within { x lo hi -- b }
  10.     x hi >= x lo <= and ;
  11.  
  12. \ generic class of windows that includes a pane of scrolling text
  13. :CLASS TscrollWind <super ctlwind
  14.  
  15.     handle    lhandle        \ handle to list
  16.     rect     rview        \ scrollable area
  17.     rect    pane        \ rview plus scroll bar
  18. \    rect     databounds    \ always 1 column
  19.     int        theFont
  20.     int        fontSize
  21.     int        usage        \ how to respond to shift, command, etc.
  22.     int        AutoScroll    \ if true, then when new item is printed, scroll to it immediately
  23.     point    theCell        \ to determine if a cell is selected...col,row
  24.  
  25. \ **********************
  26. \ INIT METHODS
  27.  
  28.   :M setRect: put: rview get: rview swap 15 + swap put: pane
  29.     -1 -1 inset: pane ;M
  30.  
  31.   :M setListFont: put: fontSize put: theFont ;M
  32.   :M setUsage: put: usage ;M
  33.   :M restoreFont: get: theFont tfont get: fontSize tsize ;M
  34.   :M autoScroll: ( n --) put: autoscroll ;M
  35.  
  36. \ **********************
  37.  
  38. \ sets selflags
  39.   :M usage: get: usage get: lhandle -dup IF >ptr 36 + c! THEN ;M
  40.  
  41.   :M newList: get: theFont tfont get: fontSize tsize
  42.     0 abs: rview 0 0 1 0 put: tempRect abs: tempRect
  43.     size: rview drop 0 pack
  44.     word0 abs: self
  45.     true bool                 \ drawit
  46.     get: growFlg bool         \ growbox?
  47.     false bool true bool     \ no horizontal scroll, yes vert scroll
  48.     call lnew put: lhandle usage: self ;M
  49.  
  50.   :M new: alive: self not IF new: super newList: self ELSE select: self THEN -curs ;M
  51.  
  52.   :M getnew: alive: self not IF getnew: super newList: self ELSE select: self THEN -curs ;M
  53.  
  54.   :M closeList: get: lhandle call ldispose clear: lhandle ;M
  55.  
  56.   :M close: alive: self IF closeList: self close: super THEN ;M
  57.  
  58.   :M draw: pushPort set: self restoreFont: self
  59.     ^base 24 + @ get: lhandle call lupdate draw: pane popPort
  60.     draw: super ;M
  61.  
  62. \  :M addCols: { count -- }
  63. \    w0 count makeint 0 makeint get: lhandle call laddcolumn i->l drop ;M
  64.  
  65.   :M NRows: ( -- n) ptr: lhandle 84 + w@ 2/ ;M
  66.  
  67.   :M addRows: { count row# -- }
  68.     word0 count makeint row# makeint get: lhandle call lAddRow i->l drop ;M
  69.  
  70. ( -- x )
  71.   :M SelectedCell: 0 get: lhandle call LLastClick unpack swap drop ;M
  72.  
  73. ( tf -- )
  74.   :M drawing: { drawIt -- } get: lhandle
  75.     IF drawIt bool get: lhandle call LDoDraw THEN ;M 
  76.  
  77. \ replaces text and cell index
  78.   :M putText: { addr len index -- }
  79.     addr +base len makeint 0 index pack get: lhandle call lSetCell ;M
  80.  
  81. \ concatenates text to current row 
  82.   :M addText: { addr len -- } alive: self
  83.     IF addr +base len 255 min
  84.         makeint 0 Nrows: self 1- pack get: lhandle call laddtocell
  85.     THEN ;M
  86.  
  87. ( -- addr len ) \ get text that was selected
  88.   :M getText: pad +base dup 2+ swap 0 selectedCell: self pack
  89.         get: lhandle call LgetCell pad 1+ count ;M
  90.  
  91. \ positions list so that selected cell is visible
  92.   :M position: get: autoScroll IF get: lhandle call lAutoScroll THEN ;M
  93.  
  94. \ selects the nth item in the list if flag=true;deselect if flag=false
  95.   :M selectCell: { flag index -- } flag bool  0 index pack get: lhandle
  96.         call lSetSelect position: self ;M
  97.  
  98.   :M hilite: { index -- } 1 index selectCell: self ;M
  99.   :M nohilite: { index -- } 0 index selectCell: self ;M
  100.  
  101. \ puts text to new row at end of list, hilites it, and scrolls down
  102.   :M newText: { addr len \ #rows -- }
  103.     Nrows: self -> #rows
  104.     1 #rows addRows: self addr len #rows putText: self
  105.     #rows hilite: self position: self #rows nohilite: self ;M
  106.  
  107.   :M IsCellSelected: ( ind --) 0 swap put: theCell
  108.         0 makeint true makeint abs: theCell get: lhandle call lGetSelect i->l ;M
  109.  
  110.   :M lHandle: get: lhandle ;M
  111.  
  112.   :M classinit: classinit: super 'c null put: draw true put: autoScroll ;M
  113.  
  114. ;CLASS
  115.  
  116. control SelectBut    \ the ok button
  117. control    NoneBut
  118. control AllBut
  119. control defaultBut
  120.  
  121. :CLASS listWind <super TscrollWind
  122.  
  123.     var        dblAct        \ what to do on dblClick
  124.     var        act1        \ what to do if a cell is selected
  125.  
  126. \ **********************
  127. \ INIT METHODS
  128.  
  129.   :M dblAction: put: dblAct ;M
  130.   :M putMyAct: put: act1 ;M
  131. \ **********************
  132.  
  133. ( --tf)
  134.   :M ptInArea: where: themouse pack Ptin: pane ;M
  135.  
  136.   :M  CONTENT:  active: self
  137.         IF  ptInArea: self
  138.             IF    word0 where: fevent g->l mods: fevent makeint
  139.                 get: lhandle call lclick i->l        \ if true, dblclick
  140.                 selectedCell: self 0< not
  141.                 IF exec: act1 THEN                    \ enable buttons if cell selected
  142.                 IF exec: dblAct THEN
  143.             ELSE ^base ctlHit?  not
  144.                  IF exec: content THEN
  145.             THEN
  146.         ELSE  (abs) call SelectWindow
  147.         THEN ;M
  148.  
  149. \ if it's a cr then accept the selections and exit
  150.   :M key: $ 000000ff and 13 = IF 1 exec: SelectBut ELSE errbeep THEN ;M
  151.  
  152.   :M classinit: classinit: super 'c null dup put: dblAct put: act1 ;M
  153.  
  154. ;CLASS
  155.  
  156.  
  157. listWind Modwind
  158. 10 30 110 162 setrect: Modwind
  159. 3 9 setListFont: Modwind
  160. 68 setusage: Modwind    \ allow multiple clicks without a modifier key
  161. -10000 dup 10000 dup true setdrag: Modwind
  162.  
  163. sarray modList
  164.  
  165. : (.mod)  { theCfa size -- }  curs -curs theCfa  ?mod
  166.     IF  theCfa >name n>count
  167.         2dup " IMOD" s= not IF add: modList ELSE 2drop THEN
  168.     THEN  -> curs ;
  169.  
  170. \ list modules and their load status
  171. : .mods   'c (.mod)  0 trav  ;
  172.  
  173.  
  174. \ fills the list using names in ModList 
  175. : fillCol
  176.     false drawing: Modwind limit: modList 0
  177.     DO  i at: modList i putText: Modwind
  178.     LOOP true drawing: Modwind ;
  179.  
  180. : prepList limit: ModList 0 addrows: Modwind fillCol ;
  181.  
  182. : buildModWind new: modList .mods 200 200 430 385 put: temprect
  183.     temprect " Modules" docWind false false new: ModWind
  184.     140 80 " Ok" modWind new: selectBut
  185.     140 110 " All" modWind new: AllBut
  186.     140 140 " None" modWind new: NoneBut
  187.     140 50 " Default" modWind new: defaultBut
  188.     -curs 1000 1000 gotoxy
  189.         size: modList
  190.         IF     prepList THEN show: modwind ;
  191.  
  192. : ModTitle -curs 0 tfont 12 tsize 10 19 gotoxy ." Select all mods to include…"
  193.     restoreFont: modWind ;
  194.  
  195. 4 'cfas null null modTitle errbeep actions: modwind
  196. 2 'cfas null null setact: modwind
  197.  
  198. 20 ordered-col nmods
  199.  
  200. : acceptSelect clear: nmods
  201.     nrows: modWind 0 DO i isCellSelected: modWind
  202.         IF i at: modList sfind 2drop cfa add: nmods THEN loop
  203.     close: modWind release: modList ;
  204.  
  205. : selectAll nrows: modWind 0 DO true i selectCell: modWind LOOP ;
  206. : selectNone nrows: modWind 0 DO false nrows: modWind i- 1-  selectCell: modWind LOOP ;
  207.  
  208. 'c acceptSelect actions: selectbut
  209. 'c selectAll actions: allBut
  210. 'c selectNone actions: noneBut
  211.  
  212. 6 ordered-col defaultMods
  213. 'c AlertMod add: defaultMods
  214. 'c indMod add: defaultMods
  215. 'c PrintMod add: defaultMods
  216. 'c sortMod add: defaultMods
  217. 'c aboutMod add: defaultMods
  218. 'c env add: defaultMods
  219.  
  220. : selectDefaults limit: modList 0
  221.     DO i at: modList sfind 2drop cfa indexof: defaultMods
  222.         IF drop true i selectCell: modWind  THEN
  223.     LOOP ;
  224.  
  225. 'c SelectDefaults actions: defaultBut
  226.